home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / backup / backup.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  4KB  |  161 lines
  1. {
  2.  Designer: Craig Ward
  3.  Date:     6/9/95
  4.  
  5.  Function: Backup dialog. User specificies the source and destination directories,
  6.            then the dialog will copy all files.
  7.  
  8.  Notes:    The user selects which path to set via the radioGroup. However, there
  9.            was a problem in that when the radioGroup index was changed, for some
  10.            reason the label that was being de-activated as the directoryList's
  11.            DirLabel, was still active.
  12.  
  13.            To overcome this I introduced a label, invisible at run-time, which
  14.            acts as an intermediate between the changing of the directoryList's
  15.            DirLabel.
  16. *********************************************************************************}
  17. unit Backup;
  18.  
  19. interface
  20.  
  21. uses
  22.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  23.   Forms, Dialogs, StdCtrls, Buttons, FileCtrl, Gauges, ExtCtrls;
  24.  
  25. type
  26.   TBackupDlg = class(TForm)
  27.     DirList: TDirectoryListBox;
  28.     FList: TFileListBox;
  29.     Label1: TLabel;
  30.     lblSource: TLabel;
  31.     Label2: TLabel;
  32.     lblDestination: TLabel;
  33.     btnOK: TBitBtn;
  34.     btnCancel: TBitBtn;
  35.     btnHelp: TBitBtn;
  36.     Panel1: TPanel;
  37.     Gauge1: TGauge;
  38.     RGroup: TRadioGroup;
  39.     lblInVisible: TLabel;
  40.     procedure btnHelpClick(Sender: TObject);
  41.     procedure btnCancelClick(Sender: TObject);
  42.     procedure DirListChange(Sender: TObject);
  43.     procedure FormActivate(Sender: TObject);
  44.     procedure RGroupClick(Sender: TObject);
  45.     procedure btnOKClick(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.     procedure CopyFiles;
  49.   public
  50.     { Public declarations }
  51.   end;
  52.  
  53. var
  54.   BackupDlg: TBackupDlg;
  55.  
  56. implementation
  57.  
  58. {$R *.DFM}
  59.  
  60. uses
  61.  LZExpand;
  62.  
  63. {***Buttons*********************************************************************}
  64. {help}
  65. procedure TBackupDlg.btnHelpClick(Sender: TObject);
  66. begin
  67.  Application.HelpCommand(HelpContext,btnHelp.HelpContext);
  68. end;
  69.  
  70. {close}
  71. procedure TBackupDlg.btnCancelClick(Sender: TObject);
  72. begin
  73.  close;
  74. end;
  75.  
  76. {copy}
  77. procedure TBackupDlg.btnOKClick(Sender: TObject);
  78. begin
  79.  CopyFiles;
  80. end;
  81.  
  82. {***Directory list**************************************************************}
  83. procedure TBackupDlg.DirListChange(Sender: TObject);
  84. var
  85.  i: integer;
  86. begin
  87.  i := RGroup.ItemIndex;
  88.  case i of
  89.   0:
  90.    DirList.DirLabel := lblSource;
  91.   1:
  92.    DirList.DirLabel := lblDestination;
  93.  end;
  94. end;
  95.  
  96. {***form preferences************************************************************}
  97. {on activation of the form, set the RGroup index}
  98. procedure TBackupDlg.FormActivate(Sender: TObject);
  99. begin
  100.  RGroup.ItemIndex := 0;
  101. end;
  102.  
  103. {***Radio group*****************************************************************}
  104. {intermediate step in changing directoryList's DirLabel}
  105. procedure TBackupDlg.RGroupClick(Sender: TObject);
  106. begin
  107.  DirList.DirLabel := lblInVisible;
  108. end;
  109.  
  110. {***Copy proc******************************************************************}
  111. procedure TBackupDlg.CopyFiles;
  112. var
  113.  sLD,sS,sD: string;
  114.  sI,dI,nI,pI: integer;
  115. begin
  116.  {first, check paths}
  117.  if CompareStr(lblSource.Caption,lblDestination.Caption) = 0 then
  118.   begin
  119.    messageDlg('Can not overwrite existing files',mtWarning,[mbOK],0);
  120.    exit;
  121.   end;
  122.  
  123.  {set desintation path string}
  124.  sLD := lblDestination.Caption;
  125.  {set directory-list to source path}
  126.  DirList.Directory := lblSource.Caption;
  127.  
  128.  {calc progress to add to gauge}
  129.  pI := 100 div (FList.Items.Count);
  130.   Panel1.Visible := True;
  131.  
  132.  {init for loop}
  133.  for nI := 0 to FList.Items.Count -1 do
  134.   begin
  135.    {set file names}
  136.    sS := ExpandFileName(FList.Items.Strings[nI]);
  137.    sD := sLD + '\' + ExtractFileName(FList.Items.Strings[nI]);
  138.  
  139.    {set file handles}
  140.    sI := FileOpen(sS,0);
  141.    dI := FileCreate(sD);
  142.  
  143.    {set buffer, execute, clear buffer}
  144.    LZStart;
  145.     CopyLZFile(sI,dI);
  146.    LZDone;
  147.  
  148.    {close files}
  149.    FileClose(sI);
  150.    FileClose(dI);
  151.  
  152.    {update gauge}
  153.    Gauge1.AddProgress(pI);
  154.    Application.ProcessMessages;
  155.   end;
  156.  Panel1.Visible := False;
  157. end;
  158.  
  159. {*******************************************************************************}
  160. end.
  161.